Inspecting model behavior

lit_list = function(theta,phi) {
    theta_cat = round(theta *20)
    return(1/(21-theta_cat))
    
}

pragmatic_speaker = function(theta1,theta2,phi) {
  
  utt1_num = 0
  if (theta1 <= phi) {
    utt1_num = lit_list(theta1, phi)
  }
  
  utt2_num = 0
   if (theta2 <= phi) {
    utt2_num = lit_list(theta2, phi)
   }
  
  other_num = 0.001
  
  denom = other_num + utt1_num + utt2_num
  return(utt1_num/denom)

}



approx_pragmatic_speaker = function(theta1,theta2,phi) {
  
  utt1_num = 0
  if (theta1 <= phi) {
    theta1_cat = round(theta1 *20)
    utt1_num = 1/(21-theta1_cat)
  }
  
  utt2_num = 0
   if (theta2 <= phi) {
    if (theta2 < 1.1) {
      x = seq(0, min(1, phi), 0.05)
      y = lit_list(x, phi)
      utt2_num =weighted.mean(y, c(1,1,1,1,1,1,2,3,5,10,5,3,2,1,1,1,1,1,1,1,1)[1:length(y)])
    } else {
      x = seq(0.9, phi, 0.05)
      y = lit_list(x, phi)
      utt2_num = mean(y)
    }
   }
  
  other_num = 0.001
  
  denom = other_num + utt1_num + utt2_num
  return(utt1_num/denom)

}

crude_approx_pragmatic_speaker = function(theta1,theta2,phi) {
  
  utt1_num = 0
  if (theta1 <= phi) {
    theta1_cat = round(theta1 *20)
    utt1_num = 1/(21-theta1_cat)
  }
  
  utt2_num = 0
   if (theta2 <= phi) {
    x = seq(0, phi, 0.05)
    y = lit_list(x, phi)
    t = (21 - length(y))
    if (length(y) < 21) {
      y = c(y, rep.int(0, t))
    }
    utt2_num = weighted.mean(y, c(1,1,1,1,1,1,2,3,5,10,5,3,2,1,1,1,1,1,1,1,1))
   }
  
  other_num = 0.001
  
  denom = other_num + utt1_num + utt2_num
  return(utt1_num/denom)

}

  d = data.frame(phi = rep(seq(0,1,0.05), 1, each=441), theta1 = rep(seq(0,1,0.05), 21, each=21), theta2 = rep(seq(0,1,0.05), 441))
  
d$type = "exact"
d = d %>%
  rowwise() %>%
  mutate(speaker = pragmatic_speaker(theta1, theta2, phi))


d2 =  d %>%
  rowwise() %>%
  mutate(speaker = approx_pragmatic_speaker(theta1, theta2, phi), type="approx")

d = rbind(d,d2)

  d %>% ggplot(aes(x=theta2, y=speaker, col=type)) + geom_line() + geom_point() + facet_wrap(~theta1+phi,ncol=21)

  d = data.frame(phi = rep(seq(0,1,0.05), 1, each=441), theta1 = rep(seq(0,1,0.05), 21, each=21), theta2 = rep(seq(0,1,0.05), 441))
  
d$type = "exact"
d = d %>%
  rowwise() %>%
  mutate(speaker = pragmatic_speaker(theta1, theta2, phi))


d2 =  d %>%
  rowwise() %>%
  mutate(speaker = approx_pragmatic_speaker(theta1, theta2, phi), type="approx")

d3 =  d %>%
  rowwise() %>%
  mutate(speaker = crude_approx_pragmatic_speaker(theta1, theta2, phi), type="crude_approx")


d = rbind(d,d2, d3)


  d %>% group_by(type,phi) %>% summarize(speaker_m=mean(speaker)) %>%
    ggplot(aes(x=phi, y=speaker_m, col=type)) + geom_line() + geom_point()

## Warning: Grouping rowwise data frame strips rowwise nature